;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Eric Bavier <bavier@member.fsf.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (guix import arch)
  #:use-module (srfi srfi-26)
  #:use-module (ice-9 match)
  #:use-module (ice-9 regex)
  #:use-module (ice-9 rdelim)           ;read-line
  #:use-module (guix build utils)
;  #:use-module (guix import json)
  #:use-module (guix import utils)
  #:use-module (guix store)
  #:use-module (guix records)
  #:use-module (guix packages)
  #:use-module (guix derivations)
  #:use-module (guix upstream)
  #:export (%arch-updater))

;;; Commentary:
;;;
;;; Checks the Arch package repository for updates.
;;;
;;; Code:

;;; TODO: We want something similar to (@ (guix git)
;;; latest-repository-commit), except that we don't want to copy the git
;;; repository into the store.  We're content with reading info directory from
;;; the repository.  OTOH we need to do some of the same things that
;;; latest-repository-commit does, like derive a chace directory name, check
;;; if the caches exists, clone it if no or fetch if yes.  Maybe we could
;;; factor those parts out of latest-repository-commit, basically everything
;;; but the final copy-to-store.
;; (define %arch-package-repo
;;   (delay
;;     (let )))

;; (define* (arch-pkgbuild package
;;                         #:optional
;;                         (repo-base (force %arch-package-repo)))
;;   (let ((name (package-name package)))
;;     (string-append repo-base "/" name "/trunk/PKGBUILD")))

;; (define (arch-package? package)
;;   "Return true if PACKAGE is a package in the ArchLinux package repository,
;; else false."
;;   (file-exists? (arch-pkgbuild package)))

;;; TODO: While the JSON-API access is nice, it doesn't give us information
;;; about the upstream source-url or signing keys, which is very useful to us.
;;; So I think we really need to go with the git checkout method.
;; (define arch-info
;;   (mlambda (name)
;;     (match
;;      (assoc-ref
;;       (json-fetch-alist
;;        (string-append "https://www.parabola.nu/packages/search/json/"
;;                       "?limit=1&name=" name))
;;       "results")
;;      ((meta _ ...) (pk 'meta meta))
;;      (else #f))))

(define (git-package)
  "Return the 'git-minimal' package.  This is a lazy reference so that we
don't depend on (gnu packages version-control)"
  (module-ref (resolve-interface '(gnu packages version-control))
              'git))                    ;TODO: git-minimal once updated

(define %arch-packages
  (let ((cache "/tmp/bavier/arch-packages"))
    (delay
      (if (access? cache R_OK) cache
          (let* ((git (string-append
                       (with-store store
                         (derivation->output-path
                          (package-derivation store (git-package))))
                       "/bin/git")))
            (and (access? git X_OK)
                 (mkdir-p cache)
                 (chdir cache)
                 (system* "git" "init")
                 (system* "git" "remote" "add" "origin"
                          "git://git.archlinux.org/svntogit/packages.git")
                 (system* "git" "fetch" "--depth=1" "origin" "master")
                 (system* "git" "config" "core.sparseCheckout" "true")
                 (with-output-to-file ".git/info/sparse-checkout"
                   (lambda () (display "**/trunk/PKGBUILD") #t))
                 (system* "git" "checkout" "master")
                 cache))))))
;;; TODO: Maybe also pull in packages from the "Community" collection at
;;; https://git.archlinux.org/svntogit/community.git
(define %arch-community
  (let ((cache "/tmp/bavier/arch-community"))
    (delay cache)))                     ;TODO!

(define (arch-pkgbuild name)
  "Return the file-name of the \"PKGBUILD\" file for NAME, a package name, or
#f if none exists."
  (define (check-access filename)
    (and (access? filename R_OK) filename))
  (define (pkgbuild base)
    (check-access (string-append base "/" name "/trunk/PKGBUILD")))
  (or (and=> (force %arch-packages)  pkgbuild)
      (and=> (force %arch-community) pkgbuild)))

(define (arch-info name)
  (and=> (arch-pkgbuild name)
         (lambda (pkgbuild)
           (let ((version-rx (make-regexp "^_?pkgver=(.*)$")) ;XXX: probably the '_' breaks things
                 (source-rx (make-regexp "^source=\\([\"']?([^::]*::)?([^\"]*)[\"']?.*$")))
             (call-with-input-file pkgbuild
               (lambda (port)
                 (let loop ((meta '()))
                   (let ((line (read-line port)))
                     (cond
                      ((eof-object? line) meta)
                      ((regexp-exec version-rx line)
                       => (lambda (m)
                            (loop (alist-cons "version" (match:substring m 1)
                                              meta))))
                      ((regexp-exec source-rx line)
                       => (lambda (m)
                            (loop
                             ;; TODO: This is not perfect, since urls may
                             ;; contain more sophisticated substitutions.
                             ;; E.g. common is stripping or replacement:
                             ;; ${pkgver/./_}, ${_relver//\//-}, etc,
                             ;; reference to arbitrary local variables:
                             ;; $_commit, $_shortname, $_tarname, $_relver.
                             ;; The contents may be split to multiple
                             ;; lines.  Since it's an array, it may list
                             ;; local Arch source files first, before the
                             ;; upstream source url.  Pacman understands a
                             ;; renaming scheme (DONE):
                             ;; foo-1.tar.gz::https://example.com/v1.tar.gz,
                             ;; May reference "${pkgbase}" in case of
                             ;; PKGBUILD that produce multiple outputs.
                             (alist-cons "source"
                                         (regexp-substitute/global
                                          #f "(\\$\\{?_?pkg(base|name|ver)\\}?)"
                                          (match:substring m 2)
                                          'pre
                                          (lambda (m')
                                            (match (match:substring m' 2)
                                                   ((or "base" "name") name)
                                                   ("ver" (assoc-ref meta "version"))))
                                          'post)
                                         meta))))
                      ;; TODO: Parse signature urls
                      (else (loop meta)))))))))))

(define (arch-package? package)
  ;; If a PKGBUILD exists, assume we can update it
  (->bool (arch-pkgbuild (package-name package))))

(define (latest-release pkg)
  (let* ((name (package-name pkg))
         (meta (arch-info name)))
    (upstream-source
     (package name)
     (version (assoc-ref meta "version"))
     (urls (or (and=> (assoc-ref meta "source") list)
               '())))))

(define %arch-updater
  (upstream-updater
   (name 'arch)
   (description "Updater for packages in Arch Linux")
   (pred arch-package?)
   (latest latest-release)))
